home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGIALS / PTUTOR2B.LZH / LIST4.PAS < prev    next >
Pascal/Delphi Source File  |  1988-01-15  |  3KB  |  117 lines
  1. program List_Pascal_Source_Files;    (* For TURBO Pascal 4.0 only *)
  2.  
  3. Uses Printer;
  4.  
  5. const Max_Lines_Per_Page = 50;
  6.  
  7. type Command_String = string[127];
  8.  
  9. var Input_File      : text;
  10.     Input_Line      : string[140];
  11.     Line_Number     : integer;
  12.     Lines_Printed   : integer;
  13.     Page_No         : integer;
  14.     Index           : integer;
  15.     Filename        : Command_String;
  16.  
  17. procedure Initialize; (* ****************************** initialize *)
  18. begin
  19.    if ParamCount = 1 then
  20.       Filename := ParamStr(1)
  21.    else begin
  22.       Write('Enter filename ----> ');
  23.       Readln(Filename);
  24.    end;
  25.    Assign(Input_File,Filename);
  26.    Reset(Input_File);
  27.    Line_Number := 1;
  28.    Lines_Printed := 66; (* This is to force a header immediately *)
  29.    Page_No := 1;
  30. end;
  31.  
  32. procedure Read_A_Line; (* **************************** read a line *)
  33. begin
  34.    for Index := 1 to 140 do Input_Line[Index] := ' ';
  35.    Readln(Input_File,Input_Line);
  36. end;
  37.  
  38. procedure Format_And_Display; (* **************** format and display *)
  39.  
  40. var Line_Length : byte;
  41.  
  42. begin
  43.    Write(Line_Number:6,'  ');
  44.    for Index := 1 to 140 do begin
  45.       if Input_Line[Index] <> ' ' then Line_Length := Index;
  46.    end;
  47.    if Line_Length <= 70 then begin           (* line length less *)
  48.       for Index := 1 to Line_Length do     (* than 70 characters *)
  49.          Write(Input_Line[Index]);
  50.       Writeln;
  51.    end
  52.    else begin             (* line length more than 70 characters *)
  53.       for Index := 1 to 70 do
  54.          Write(Input_Line[Index]);
  55.       Writeln('<');
  56.       Write('        ');
  57.       for Index := 71 to Line_Length do
  58.          Write(Input_Line[Index]);
  59.       Writeln;
  60.    end;
  61. end;
  62.  
  63. procedure Format_And_Print; (* ****************** format and print *)
  64.  
  65. var Line_Length : byte;
  66.  
  67. begin
  68.    Write(Lst,Line_Number:6,'  ');
  69.    for Index := 1 to 140 do begin
  70.       if Input_Line[Index] <> ' ' then Line_Length := Index;
  71.    end;
  72.    if Line_Length <= 70 then begin         (* line length less *)
  73.       for Index := 1 to Line_Length do   (* than 70 characters *)
  74.          Write(Lst,Input_Line[Index]);
  75.       Writeln(Lst);
  76.       Lines_Printed := Lines_Printed + 1;
  77.    end
  78.    else begin           (* line length more than 70 characters *)
  79.       for Index := 1 to 70 do
  80.          Write(Lst,Input_Line[Index]);
  81.       Writeln(Lst,'<');
  82.       Write(Lst,'        ');
  83.       for Index := 71 to Line_Length do
  84.          Write(Lst,Input_Line[Index]);
  85.       Writeln(Lst);
  86.       Lines_Printed := Lines_Printed + 2;
  87.    end;
  88.    Line_Number := Line_Number + 1;
  89. end;
  90.  
  91. procedure Check_For_Page; (* ********************** check for page *)
  92. begin
  93.    if Lines_Printed > Max_Lines_Per_Page then begin
  94.       if Page_No > 1 then
  95.          Writeln(Lst,Char(12));
  96.       for Index := 1 to 3 do
  97.          Writeln(Lst);
  98.       Write(Lst,'     ');
  99.       Writeln(Lst,'Source file ',Filename,'Page':24,Page_No:4);
  100.       Page_No := Page_No + 1;
  101.       Lines_Printed := 1;
  102.       Writeln(Lst);
  103.    end;
  104. end;
  105.  
  106. begin  (* ******************************************* main program *)
  107.    Initialize;
  108.    Check_For_Page;
  109.    repeat
  110.       Read_A_Line;
  111.       Format_And_Display;
  112.       Format_And_Print;
  113.       Check_For_Page;
  114.    until Eof(Input_File);
  115.    Writeln(Lst,Char(12));
  116. end.  (* of main program *)
  117.